home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
psgui130.zip
/
PGUIAPP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-01
|
13KB
|
416 lines
{
╔══════════════════╗
║ PGUI Graphic ║
║ App. Include ║
║ Rev. 1.00 ║
╚══════════════════╝
}
Procedure InitVGA(VPath:String);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Setup VGA Mode using BGI driver in path VPath. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
Mode:Integer;
Driver:Integer;
Begin
Driver := VGA;
Mode := VGAHi;
InitGraph( Driver, Mode, VPath);
End;
Procedure StandardScreen(Title:String);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Clears the screen and displays the header. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Begin
Mouse.Hide;
ClearDevice;
SetFillStyle(SolidFill,1);
Bar(0, 0, 639, 16);
SetColor(White);
SetBkColor(Black);
ShadeText(4, 4, Title);
Mouse.Show;
End;
Procedure Box(X1,Y1,X2,Y2:Word;C1,C2,Thick:Byte);
{Co-Ords,Box,Shadow,Box Thickness}
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Draws a graphic box, coordinates X1,Y1 to X2,Y2, using the colours ║ }
{ ║ C1 and C2. ║ }
{ ║ ║ }
{ ║ The box thickness is set by Thick and the box has a shadow. ║ }
{ ║ The shadow is always 1 in thickness, deactivated by C2 = Background. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
I :Byte;
OldClr :Word;
Begin
OldClr:=GetColor;
SetColor(C2);
Line(X2+1,Y1+5,X2+1,Y2+1);
Line(X1+4,Y2+1,X2+1,Y2+1);
SetColor(C1);
For I:=1 to Thick do
Begin
Line(X1,Y1,X2,Y1);
Line(X2,Y1,X2,Y2);
Line(X2,Y2,X1,Y2);
Line(X1,Y2,X1,Y1);
Inc(X1);
Dec(X2);
Inc(Y1);
Dec(Y2);
End;
SetColor(OldClr);
End;
Procedure ShadeText(X,Y:Word;T:String);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Displays the text at X,Y with a shadow. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
OldClr :Word;
Begin
OldClr:=GetColor;
SetColor(GetBkColor);
OutTextXY(X, Y, T);
SetColor(OldClr);
OutTextXY(X+2, Y+2, T);
End;
Procedure GraphicSpace(X,Y,Spot:Word);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Displays a space character 'Spot' number of characters from X,Y. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Begin
SetFillStyle(SolidFill,GetBkColor);
Bar(X+(Spot*TextWidth(' ')),Y,X+(Spot*TextWidth(' '))+TextWidth(' '),Y+TextWidth(' '));
End;
Procedure TwirlyCursor(X,Y,Spot:Word;Frame:Byte);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Draws the animated cursor at X,Y using frame number Frame. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
CharSize:Word;
Begin
CharSize:=TextWidth(' ');
GraphicSpace(X,Y,Spot);
Case Frame Of
1:OutTextXY(X+(Spot*CharSize),Y,'-');
2:OutTextXY(X+(Spot*CharSize),Y,'/');
3:OutTextXY(X+(Spot*CharSize),Y,'|');
4:OutTextXY(X+(Spot*CharSize),Y,'\');
5:OutTextXY(X+(Spot*CharSize),Y,'-');
6:OutTextXY(X+(Spot*CharSize),Y,'/');
7:OutTextXY(X+(Spot*CharSize),Y,'|');
8:OutTextXY(X+(Spot*CharSize),Y,'\');
End;
End;
Procedure LineCursor(X,Y,Spot:Word;OnOff:Boolean);
Var
Width,
OldClr :Word;
Begin
OldClr:=GetColor;
If Not OnOff Then SetColor(GetBkColor);
Width:=X+Spot*TextWidth(' ')-1;
Line(Width,Y,Width,Y+TextHeight(' ')-2);
SetColor(OldClr);
End;
Procedure CommentWindow(X,Y:Word;Comment:String);
Const
Head = 'Comment';
Var
CWind :GraphicWindow;
Dummy :Byte;
NewY,
Width :Word;
Done,
Held,
Doubled,
Special :Boolean;
Key :Char;
Begin
Width:=TextWidth(Comment)+20;
If Width<TextWidth(Head)+20 Then
Width:=TextWidth(Head)+20;
CWind.Open(X,Y,X+Width,Y+52+3*TextHeight(Head),Yellow,Black,3,SolidFill,Black,True);
CWind.NewHeading(Head,CentreText,White,CloseDotFill,Blue);
CWind.CloseIcon(True);
CWind.HeadingIcon(True);
Mouse.Hide;
OutTextXY(X+10,Y+20+TextHeight(Head),Comment);
Mouse.Show;
Width:=(Width Div 2)-(TextWidth('Okay') Div 2);
NewY :=Y+30+2*TextHeight(Head);
CWind.Buttons.Create(X+Width,NewY,X+10+Width+TextWidth('Okay'),NewY+10+TextHeight('Okay'),
2, Black, NIL, 'Okay', False, #13);
Done:=False;
Repeat
CWind.Buttons.WaitForClick(X, Y, Dummy, Held, Doubled, Special, Key);
If (Key=KeyCode(Key_Ctrl, Key_F5)) And
Held Then CWind.Drag;
Done:=CWind.CloseButtonNum=CWind.Buttons.Number;
Done:=Done Or ((Special=False) And (Key=#13));
Until Done;
CWind.Close;
End;
Procedure EditString(X,Y:Word;MaxLets:Byte;Upper:Boolean;Var MainStr:String);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ This will get a string at X,Y. It destroys what is on the screen. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
Ins :Boolean; {Boolean for the Insert Key Status}
C :Char; {Current Character}
Count, {Number Of Chars In String}
CurXPos :Byte; {Current X Position of Cursor}
FlashCount :LongInt;
OldClr :Word;
OnOff :Boolean;
Begin
Mouse.Hide;
Ins:=False; {The Insert key has not yet been pressed}
CurXPos:=1; {Current Relative X Position+1}
UnPadVar(MainStr,MainStr);
If Length(MainStr)>MaxLets Then
MainStr:=Copy(MainStr,1,MaxLets);
SetFillStyle(EmptyFill,GetColor);
Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
OutTextXY(X,Y,MainStr);
Count:=Length(MainStr)+1; {How many letters in the string+1}
FlashCount:=0;
OnOff:=True;
OldClr:=GetColor;
Repeat {Repeat Until [Return] is Pressed}
If Ins Then SetColor(LightRed) Else SetColor(LightGreen);
While Not KeyPressed do
Begin
Inc(FlashCount);
If FlashCount>Mouse.ComputerSpeed Then
Begin
LineCursor(X,Y,CurXPos-1,OnOff);
OnOff:=Not OnOff;
FlashCount:=0;
End;
End;
LineCursor(X,Y,CurXPos-1,False);
SetColor(OldClr);
If Upper Then
C:=UpCase(ReadKey)
Else
C:=ReadKey;
If C=Chr(0) Then {Check for a cursor key}
Begin
C:=ReadKey; {Which cursor key} {Numeric Keypad Value}
If (C='O') Then CurXPos:=Count; {1}
If (C='P') And (CurXPos>=3) Then Dec(CurXPos,2); {2}
If (C='Q') And (CurXPos>=4) Then Dec(CurXPos,3); {3}
If (C='K') And (CurXPos>1) Then Dec(CurXPos); {4}
If (C='M') And (CurXPos<Count) Then Inc(CurXPos); {6}
If (C='G') Then CurXPos:=1; {7}
If (C='H') And (CurXPos<=Count-2) Then Inc(CurXPos,2); {8}
If (C='I') And (CurXPos<=Count-3) Then Inc(CurXPos,3); {9}
If (C=#7 ) Then MainStr[0]:=Chr(CurXPos-1); {Shift-Del}
If (C='S') And (Count>1) Then {Del}
Begin
Bar(X,Y,X+TextWidth(MainStr),Y+TextHeight(MainStr));
Delete(MainStr,CurXPos,1);
OutTextXY(X,Y,MainStr);
Dec(Count);
End;
If (C='R') Then {Ins}
Ins:=Not Ins;